;;;
;;;
;;;	Author:
;;;		Henry C. Francis
;;;		425 N. Ashe St.
;;;		Southern Pines, NC 28387
;;;
;;;     http://paracadd.com
;;;	All rights reserved.
;;;
(DEFUN linedraw_error (msg / )
  (PRINC "\nERROR: ")
  (PRINC msg)
  (PRINC "\nLINEDRAW cancelled! ")
  (TERM_DIALOG)
  (PRINC)
)
(DEFUN C:LINEDRAW (/ old-idx ltname)
  (SETQ oldlinedraw_error *ERROR*)
  (SETQ *ERROR* linedraw_error)
  (IF c:mklayr NIL (LOAD "MKLAYR" "\nFile MKLAYR.LSP not loaded! "))
  (c:svlayr)
  (IF call_ltname NIL (setq call_ltname ""))
  (IF ln_color NIL (SETQ ln_color 1))
  (IF bg_color NIL (SETQ bg_color 7))
  (C:LoadLTypes)
  (SETQ ltnmlst (LIST "continuous" "border" "center" "dashdot" "dashed"
                      "divide" "dot" "hidden" "phantom" "fenceline1"
		      "fenceline2" "wirefence" "tracks" "tdr" "tdl" "GLR" "GLL"
		      "sedfence" "siltfence" "streamd" "streamd2" "demol"
		      "match" "contour" "treeline_r" "treeline_l"
                )
  ) ;_ end of setq
  (makeltlists)
  ;;; Initialize a dialogue from dialogue file
  (SETQ linedraw_num (LOAD_DIALOG "linedraw"))
  (IF (NOT (NEW_DIALOG "linedraw" linedraw_num "" (IF ltype_loc ltype_loc '(-1 -1))))
    (EXIT)
  ) ;_ end of if
  (SETQ dashdata (NTH 0 mdashlist))
  (ltlist_act "0" "continuous_image" -2 ln_color)
  (SETQ dashdata (NTH 0 mdashlist));existing water - continuous also - was (NTH 1 mdashlist)
  (ltlist_act "0" "border_image" -2 ln_color)
  (SETQ dashdata (NTH 2 mdashlist))
  (ltlist_act "2" "center_image" -2 ln_color)
  (SETQ dashdata (NTH 3 mdashlist))
  (ltlist_act "3" "dashdot_image" -2 ln_color)
  (SETQ dashdata (NTH 4 mdashlist))
  (ltlist_act "4" "dashed_image" -2 ln_color)
  (SETQ dashdata (NTH 5 mdashlist))
  (ltlist_act "5" "divide_image" -2 ln_color)
  (SETQ dashdata (NTH 6 mdashlist))
  (ltlist_act "6" "dot_image" -2 ln_color)
  (SETQ dashdata (NTH 7 mdashlist))
  (ltlist_act "7" "hidden_image" -2 ln_color)
  (SETQ dashdata (NTH 8 mdashlist))
  (ltlist_act "8" "phantom_image" -2 ln_color)
  (SETQ dashdata (NTH 9 mdashlist))
  (ltlist_act "9" "fenceline1_image" -2 ln_color)
  (SETQ dashdata (NTH 10 mdashlist))
  (ltlist_act "10" "wirefence_image" -2 ln_color)
  (SETQ dashdata (NTH 11 mdashlist))
  (ltlist_act "11" "fenceline2_image" -2 ln_color)
  (SETQ dashdata (NTH 12 mdashlist))
  (ltlist_act "12" "tracks_image" -2 ln_color)
  (SETQ dashdata (NTH 13 mdashlist))
  (ltlist_act "13" "tdr_image" -2 ln_color)
  (SETQ dashdata (NTH 14 mdashlist))
  (ltlist_act "14" "tdl_image" -2 ln_color)
  (SETQ dashdata (NTH 15 mdashlist))
  (ltlist_act "15" "GLR_image" -2 ln_color)
  (SETQ dashdata (NTH 16 mdashlist))
  (ltlist_act "16" "GLL_image" -2 ln_color)
  (SETQ dashdata (NTH 17 mdashlist))
  (ltlist_act "17" "sedfence_image" -2 ln_color)
  (SETQ dashdata (NTH 18 mdashlist))
  (ltlist_act "18" "siltfence_image" -2 ln_color)
  (SETQ dashdata (NTH 19 mdashlist))
  (ltlist_act "19" "streamd_image" -2 ln_color)
  (SETQ dashdata (NTH 20 mdashlist))
  (ltlist_act "20" "streamd2_image" -2 ln_color)
  (SETQ dashdata (NTH 21 mdashlist))
  (ltlist_act "21" "demol_image" -2 ln_color)
  (SETQ dashdata (NTH 22 mdashlist))
  (ltlist_act "22" "match_image" -2 ln_color)
  (SETQ dashdata (NTH 23 mdashlist))
  (ltlist_act "23" "contour_image" -2 ln_color)
  (SETQ dashdata (NTH 24 mdashlist))
  (ltlist_act "24" "treeline_r_image" -2 ln_color)
  (SETQ dashdata (NTH 25 mdashlist))
  (ltlist_act "25" "treeline_l_image" -2 ln_color)
  (SET_TILE "edit_lt" call_ltname)
  (ACTION_TILE
    "continuous_image"
    "(setq ltname \"continuous\")(set_tile\"edit_lt\"\"continuous\")(setq mjrg \"C\" llt \"-\" prod \"0OHE\" colr \"6\" modf \"LINE\")(done_dialog)"
  ) ;_ end of action_tile
  (ACTION_TILE
    "border_image"
    "(setq ltname \"continuous\")(set_tile\"edit_lt\"\"continuous\")(setq mjrg \"C\" llt \"-\" prod \"0O0W\" colr \"5\" modf \"LINE\")(done_dialog)"
;;;    "(setq ltname \"border\")(set_tile\"edit_lt\"\"border\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "center_image"
    "(setq ltname \"center\")(set_tile\"edit_lt\"\"center\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "dashdot_image"
    "(setq ltname \"dashdot\")(set_tile\"edit_lt\"\"dashdot\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "dashed_image"
    "(setq ltname \"dashed\")(set_tile\"edit_lt\"\"dashed\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "divide_image"
    "(setq ltname \"divide\")(set_tile\"edit_lt\"\"divide\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "dot_image"
    "(setq ltname \"dot\")(set_tile\"edit_lt\"\"dot\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "hidden_image"
    "(setq ltname \"hidden\")(set_tile\"edit_lt\"\"hidden\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "phantom_image"
    "(setq ltname \"phantom\")(set_tile\"edit_lt\"\"phantom\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "fenceline1_image"
    "(setq ltname \"fenceline1\")(set_tile\"edit_lt\"\"fenceline1\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "fenceline2_image"
    "(setq ltname \"fenceline2\")(set_tile\"edit_lt\"\"fenceline2\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "wirefence_image"
    "(setq ltname \"wirefence\")(set_tile\"edit_lt\"\"wirefence\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "tracks_image"
    "(setq ltname \"tracks\")(set_tile\"edit_lt\"\"tracks\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "tdr_image"
    "(setq ltname \"tdr\")(set_tile\"edit_lt\"\"tdr\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "tdl_image"
    "(setq ltname \"tdl\")(set_tile\"edit_lt\"\"tdl\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "GLR_image"
    "(setq ltname \"GLR\")(set_tile\"edit_lt\"\"GLR\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "GLL_image"
    "(setq ltname \"GLL\")(set_tile\"edit_lt\"\"GLL\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "sedfence_image"
    "(setq ltname \"sedfence\")(set_tile\"edit_lt\"\"sedfence\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "siltfence_image"
    "(setq ltname \"siltfence\")(set_tile\"edit_lt\"\"siltfence\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "streamd_image"
    "(setq ltname \"streamd\")(set_tile\"edit_lt\"\"streamd\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "streamd2_image"
    "(setq ltname \"streamd2\")(set_tile\"edit_lt\"\"streamd2\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "demol_image"
    "(setq ltname \"demol\")(set_tile\"edit_lt\"\"demol\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "match_image"
    "(setq ltname \"match\")(set_tile\"edit_lt\"\"match\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "contour_image"
    "(setq ltname \"contour\")(set_tile\"edit_lt\"\"contour\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "treeline_r_image"
    "(setq ltname \"treeline_r\")(set_tile\"edit_lt\"\"treeline_r\")"
  ) ;_ end of action_tile
  (ACTION_TILE
    "treeline_l_image"
    "(setq ltname \"treeline_l\")(set_tile\"edit_lt\"\"treeline_l\")"
  ) ;_ end of action_tile
  (ACTION_TILE "edit_lt" "(ltedit_act)")
  (ACTION_TILE
    "accept"
    "(setq ltname(get_tile\"edit_lt\"))(setq ltype_loc(done_dialog 1))"
  ) ;_ end of action_tile
  (ACTION_TILE "cancel" "(reset-lt)")
  (SET_TILE "part_lbl" "")
;;;  (COND ((EQUAL (SUBSTR return_to 1 3) "dft")
;;;         (SET_TILE "part_lbl" "Pipe Fitting (dbl) line")
;;;        )
;;;        ((EQUAL (SUBSTR return_to 1 3) "sft")
;;;         (SET_TILE "part_lbl" "Pipe Fitting (sgl) line")
;;;        )
;;;        ((EQUAL (SUBSTR return_to 1 3) "dbl")
;;;         (SET_TILE "part_lbl" "     Double Line piping")
;;;        )
;;;        ((EQUAL (SUBSTR return_to 1 3) "sgl")
;;;         (SET_TILE "part_lbl" "     Single Line piping")
;;;        )
;;;        ((EQUAL (SUBSTR return_to 1 3) "ctr")
;;;         (SET_TILE "part_lbl" "     Piping centerline")
;;;        )
;;;  ) ;_ end of cond
  (IF (= (START_DIALOG) 1)
    (PROGN 
      (IF (EQ alllts "1")
        (PROGN
          (SET_TILE "dft_lt_text" ltname)
          (SET_TILE "sft_lt_text" ltname)
          (SET_TILE "dbl_lt_text" ltname)
          (SET_TILE "sgl_lt_text" ltname)
          (SETQ alllt_index (ITOA(getindex ltname ltnmlst)))
          (ltlist_act alllt_index "dft_lt_image" -2 dft_colr)
          (ltlist_act alllt_index "sft_lt_image" -2 sft_colr)
          (ltlist_act alllt_index "dbl_lt_image" -2 dbl_colr)
          (ltlist_act alllt_index "sgl_lt_image" -2 sgl_colr)
          (SETQ dft_ltname ltname)
          (SETQ sft_ltname ltname)
          (SETQ dbl_ltname ltname)
          (SETQ sgl_ltname ltname)
          ltname
        )
        (PROGN
      (SET_TILE return_to ltname)
           (ltlist_act
             (ITOA (getindex ltname ltnmlst))
             (STRCAT (SUBSTR return_to 1 7) "image")
             -2
             ln_color
           ) ;_ end of ltlist_act
           (SET (READ (STRCAT (SUBSTR return_to 1 6) "name")) ltname)
           (SET (READ (STRCAT (SUBSTR return_to 1 4) "colr")) ln_color)
           ltname
        )
      )
    ) ;_ end of progn
    eltype
  ) ;_ end of if
  (c:mklayr)
  (command ".line" pause)
  (SETQ *ERROR* oldlinedraw_error)
  (princ)
) ;_ end of defun

(DEFUN makeltlists (/ ltlist ltname)
  (SETQ mdashlist nil)
  (FOREACH ltname ltnmlst
    (SETQ ltlist (TBLSEARCH "LTYPE" ltname))
    (IF (= ltname "continuous")
      (SETQ mdashlist (APPEND mdashlist (LIST "CONT")))
      (SETQ mdashlist (APPEND mdashlist (LIST (add-mdash ltlist)))) ;_ end of setq
    ) ;_ end of if
  ) ;_ end of foreach
) ;_ end of defun


(DEFUN col_tile (tile color patlist ln_color / image_x image_y)
  (SETQ image_x (DIMX_TILE tile))
  (SETQ image_y (DIMY_TILE tile))
  (START_IMAGE tile)
  (FILL_IMAGE 0 0 image_x image_y color)
  (IF patlist
    (drawpattern image_x (/ image_y 2) patlist ln_color)
    (tile_rect 0 0 image_x image_y 7)
  ) ;_ end of if
  (END_IMAGE)
) ;_ end of defun

(DEFUN drawpattern (boxlength y2 pattern color / x1 x2 dash)
  (SETQ x1 0
        x2 0
  ) ;_ end of setq
  (SETQ patlist pattern)
  (SETQ fx 30)
  (IF (= patlist "CONT")
    (PROGN (SETQ dash boxlength) (vi) (SETQ x1 boxlength)) ;_ end of progn
    (FOREACH dash patlist
      (IF (> (ABS dash) 2.5)
        (SETQ fx 2)
      ) ;_ end of if
    ) ;_ end of foreach
  ) ;_ end of if
  (WHILE (< x1 boxlength)
    (IF (SETQ dash (CAR patlist))
      (PROGN (SETQ dash (FIX (* fx dash)))
             (COND ((= dash 0) (SETQ dash 1) (vi))
                   ((> dash 0) (vi))
                   (T
                    (IF (< (ABS dash) 2)
                      (SETQ dash 2)
                    ) ;_ end of if
                    (SETQ x2 (+ x2 (ABS dash)))
                   )
             ) ;_ end of cond
             (SETQ patlist (CDR patlist))
             (SETQ x1 x2)
      ) ;_ end of progn
      (SETQ patlist pattern)
    ) ;_ end of if
  ) ;_ end of while
) ;_ end of defun

(DEFUN vi () (SETQ x2 (+ x2 dash)) (VECTOR_IMAGE x1 y2 x2 y2 color)) ;_ end of defun

(DEFUN ltlist_act (index tile bg_color ln_color /)
;;; Update the list box, edit box, and color tile
  (SET_TILE "error" "")
  (SETQ lt-idx (ATOI index))
  (SETQ ltname (NTH lt-idx ltnmlst))
  (SETQ dashdata (NTH lt-idx mdashlist))
  (col_tile tile -2 dashdata ln_color)
  (SET_TILE "list_lt" (ITOA lt-idx))
  (SET_TILE "edit_lt" ltname)
) ;_ end of defun

(DEFUN add-mdash (ltlist1 / dashlist assoclist dashsize)
  (SETQ dashlist nil)
  (WHILE (SETQ assoclist (CAR ltlist1))
    (IF (= (CAR assoclist) 49)
      (PROGN (SETQ dashsize (CDR assoclist))
             (SETQ dashlist (CONS dashsize dashlist))
      ) ;_ end of progn
    ) ;_ end of if
    (SETQ ltlist1 (CDR ltlist1))
  ) ;_ end of while
  (SETQ dashlist (REVERSE dashlist))
) ;_ end of defun

(DEFUN tile_rect (x1 y1 x2 y2 color)
  (SETQ x2 (- x2 1))
  (SETQ y2 (- y2 1))
  (VECTOR_IMAGE x1 y1 x2 y1 color)
  (VECTOR_IMAGE x2 y1 x2 y2 color)
  (VECTOR_IMAGE x2 y2 x1 y2 color)
  (VECTOR_IMAGE x1 y2 x1 y1 color)
) ;_ end of defun

(DEFUN reset-lt () (SETQ lt-idx old-idx) (DONE_DIALOG 0)) ;_ end of defun

(DEFUN ltedit_act ()
  (SETQ ltvalue (STRCASE (GET_TILE "edit_lt")))
  (IF (SETQ lt-idx (getindex ltvalue ltnmlst))
    (PROGN (SET_TILE "error" "")
           (ltlist_act (ITOA lt-idx) "show_image" -2 ln_color)
    ) ;_ end of progn
    (PROGN (SET_TILE "error" "Invalid linetype.") (SETQ lt-idx old-idx)) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

(DEFUN getindex (item itemlist / m n)
  (SETQ n (LENGTH itemlist))
  (IF (> (SETQ m (LENGTH (MEMBER item itemlist))) 0)
    (- n m)
    nil
  ) ;_ end of if
) ;_ end of defun

(DEFUN C:LoadLTypes ()
  (SETQ acad_lin_fnd (FINDFILE "acad.lin"))
  (IF acad_lin_fnd
    (PROGN
           (IF (NOT (TBLSEARCH "LTYPE" "BORDER"))
             (COMMAND "linetype" "load" "BORDER" acad_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "CENTER"))
             (COMMAND "linetype" "load" "CENTER" acad_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "DASHDOT"))
             (COMMAND "linetype" "load" "DASHDOT" acad_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "DASHED"))
             (COMMAND "linetype" "load" "DASHED" acad_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "DIVIDE"))
             (COMMAND "linetype" "load" "DIVIDE" acad_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "DOT"))
             (COMMAND "linetype" "load" "DOT" acad_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "HIDDEN"))
             (COMMAND "linetype" "load" "HIDDEN" acad_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "PHANTOM"))
             (COMMAND "linetype" "load" "PHANTOM" acad_lin_fnd "")
           ) ;_ end of if
    ) ;_ end of PROGN
  ) ;_ end of IF
  (SETQ custom_lin_fnd (FINDFILE "custom.lin"))
  (IF custom_lin_fnd
    (PROGN
      (IF initandsdichk NIL (LOAD "initandsdichk" "\nFile INITANDSDICHK.LSP not loaded! "))
      (initandsdichk)
           (IF (NOT (TBLSEARCH "LTYPE" "FENCELINE1"))
             (COMMAND "linetype" "load" "FENCELINE1" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "FENCELINE2"))
             (COMMAND "linetype" "load" "FENCELINE2" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "WIREFENCE"))
             (COMMAND "linetype" "load" "WIREFENCE" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "TRACKS"))
             (COMMAND "linetype" "load" "TRACKS" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "TDR"))
             (COMMAND "linetype" "load" "TDR" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "TDL"))
             (COMMAND "linetype" "load" "TDL" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "GLR"))
             (COMMAND "linetype" "load" "GLR" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "GLL"))
             (COMMAND "linetype" "load" "GLL" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "SEDFENCE"))
             (COMMAND "linetype" "load" "SEDFENCE" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "SILTFENCE"))
             (COMMAND "linetype" "load" "SILTFENCE" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "GUARD_R"))
             (COMMAND "linetype" "load" "GUARD_R" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "GUARD_L"))
             (COMMAND "linetype" "load" "GUARD_L" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "STREAMD"))
             (COMMAND "linetype" "load" "STREAMD" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "STREAMD2"))
             (COMMAND "linetype" "load" "STREAMD2" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "DEMOL"))
             (COMMAND "linetype" "load" "DEMOL" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "MATCH"))
             (COMMAND "linetype" "load" "MATCH" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "CONTOUR"))
             (COMMAND "linetype" "load" "CONTOUR" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "TREELINE_R"))
             (COMMAND "linetype" "load" "TREELINE_R" custom_lin_fnd "")
           ) ;_ end of if
           (IF (NOT (TBLSEARCH "LTYPE" "TREELINE_L"))
             (COMMAND "linetype" "load" "TREELINE_L" custom_lin_fnd "")
           ) ;_ end of if
    ) ;_ end of PROGN
  ) ;_ end of IF
  (PRINC)
)
